perm filename FILLR.F4[CMS,LCS] blob sn#096339 filedate 1974-04-11 generic text, type T, neo UTF8
00100		SUBROUTINE FILLER(Q,R,NE,M,NP)
00200		DIMENSION Q(1),R(1),NE(1)
00300		KK=NE(1)
00400		KJ=2
00500		DO 4 K=2,KK
00600		IF(NE(K).NE.3)GO TO 11
00700		NE(K)=KJ
00800		KJ=K+1
00900		GO TO 4
01000	11	NE(K)=0
01100	4	CONTINUE
01200		NE(KK+1)=KJ
01300	C  FINDS JUMPS
01400		DO 2 J=2,KK
01500		IF(NE(J).GT.0.OR.IFIX(Q(J)).EQ.IFIX(Q(J-1)))GO TO 2
01600	C  SKIPS VERTICAL LINES
01700		X=HALF(Q,J)+.00001
01800	C  MIDPOINT OF LINE
01900		ALT=HALF(R,J)
02000	C  THE ALTITUDE
02100		KJ=0
02200	
02300	100	DO 3 L=2,KK
02400		IF(L.EQ.J.OR.NE(L).GT.0)GO TO 3
02500	C  NEXT FINDS LINE OVERLAP
02600	CC	IF(MISS(L,X,Q,R))3,40,5
02700		IF(MISS(L,X,Q,R))3,40,40
02800	CC5	IF(Q(L).EQ.Q(L-1))GO TO 40
02900	CC	IF(POINT(L,Q,R,NE))GO TO 3
03000	C  NEXT FINDS ALT. OF CROSSING
03100	40	Y=HGHT(L,X,Q,R)
03200		IF(Y.LT.ALT)KJ=KJ+1
03300	3	CONTINUE
03400		IF(MOD(KJ,2).EQ.0)GO TO 2
03500	C  FOUND A LINE TO DRAW LINES DOWN FROM.
03600		NE(J)=-1
03700		X=-1
03800		KJ=M
03900		N=Q(J)
04000		L=Q(J-1)
04100		IF(N.LT.L)GO TO 33
04200		KJ=-KJ
04300		N=N-1
04400		GO TO 34
04500	33	N=N+1
04600	34	JA=3
04700		X=-1
04800	
04900	17	DO 6 K=N,L,KJ
05000		RK=K
05100		Y=HGHT(J,RK,Q,R)
05200		IF(X)CALL LINES(RK,Y,JA,M)
05300		JA=2
05400		H=-10000
05500	
05600	18	DO 7 I=2,KK
05700		IF(NE(I).NE.0)GO TO 7
05800	C  SKIP IF SAME LINE.
05900		IF(MISS(I,RK,Q,R))GO TO 7
06000	C  TRY NEXT POINT IF IT HIT A -1 LINE.
06100	9	B=HGHT(I,RK,Q,R)
06200		IF(B.GT.Y)GO TO 7
06300		IF(B.LE.H)GO TO 7
06400		H=B
06500	C  FOUND HIGHEST NEW POINT
06600	7	CONTINUE
06700		IF(H.EQ.Y)GO TO 31
06800	C  WIPES OUT THIS LINE SEG.
06900		IF(H.NE.-10000)GO TO 31
07000		X=1
07100		GO TO 6
07200	31	CALL LINES(RK,H,JA,M)
07300		IF(X.GT.0)CALL LINES(RK,Y,JA,M)
07400	302	X=-X
07500	6	CONTINUE
07600	2	CONTINUE
07700	
07800	301	IF(M.GE.6)CALL DPYOUT(NP)
07900		END
08000		
08100		FUNCTION HGHT(J,A,Q,R)
08200		DIMENSION Q(1),R(1)
08300		B=R(J-1)
08400		D=Q(J-1)
08500		F=Q(J)
08600		HGHT=((R(J)-B)*(A-D))/(F-D)+B
08700		IF(A.EQ.D)HGHT=B
08800		END
08900	
09000	
09100		FUNCTION MISS(J,A,Q,R)
09200		DIMENSION Q(1),R(1)
09300		B=Q(J)
09400		C=Q(J-1)
09500		MISS=0
09600		IF(B.GT.A)GO TO 1
09700		IF(B.NE.A)GO TO 2
09800		MISS=1
09900		RETURN
10000	2	IF(C.LE.A)GO TO 3
10100		RETURN
10200	1	IF(C.LT.A)RETURN
10300	3	MISS=-1
10400		END
10500	C  MISS=-1, HIT=0, POINT=1
10600	
10700		FUNCTION HALF(A,J)
10800		DIMENSION A(1)
10900		HALF=(A(J-1)-A(J))/2.+A(J)
11000		RETURN
11100		END
11200		SUBROUTINE LINES(A,B,J,I)
11300		M=A
11400		N=B
11500		IF(IABS(I).LT.6)GO TO 2
11600		IF(J.EQ.3)GO TO 1
11700		CALL AVECT(M,N)
11800		RETURN
11900	1	CALL AIVECT(M,N)
12000		RETURN
12100	2	CALL PLOT(M,N,J)
12200		RETURN
12300		END